Figures and tables based on issue motive analyses (main)

Preparations

Load models

# pol models (across performance and neutral)
m1.pol <- readRDS(file = here(pol_model_dir, "m1.pol.rds"))
m2.pol <- readRDS(file = here(pol_model_dir, "m2.pol.rds"))
m3.pol <- readRDS(file = here(pol_model_dir, "m3.pol.rds"))
m4.pol <- readRDS(file = here(pol_model_dir, "m4.pol.rds"))
m5.pol <- readRDS(file = here(pol_model_dir, "m5.pol.rds"))
m6.pol <- readRDS(file = here(pol_model_dir, "m6.pol.rds"))

# performance models
m1.per <- readRDS(file = here(nonpol_model_dir, "m1.per.rds"))
m2.per <- readRDS(file = here(nonpol_model_dir, "m2.per.rds"))
m3.per <- readRDS(file = here(nonpol_model_dir, "m3.per.rds"))
m4.per <- readRDS(file = here(nonpol_model_dir, "m4.per.rds"))
m5.per <- readRDS(file = here(nonpol_model_dir, "m5.per.rds"))
m6.per <- readRDS(file = here(nonpol_model_dir, "m6.per.rds"))

# neutral models
m1.neu <- readRDS(file = here(nonpol_model_dir, "m1.neu.rds"))
m2.neu <- readRDS(file = here(nonpol_model_dir, "m2.neu.rds"))
m3.neu <- readRDS(file = here(nonpol_model_dir, "m3.neu.rds"))
m4.neu <- readRDS(file = here(nonpol_model_dir, "m4.neu.rds"))
m5.neu <- readRDS(file = here(nonpol_model_dir, "m5.neu.rds"))
m6.neu <- readRDS(file = here(nonpol_model_dir, "m6.neu.rds"))

Load original data

data_path <- here("01_data", "analysis", "data_analysis.RData")
load(file = data_path)

Filters

initial_rows <- nrow(data_analysis)
data_prep <- data_analysis %>% 
  filter(Screen != "Question")
filtered_rows <- initial_rows - nrow(data_prep)

filtered_rows

[1] 5389

data_full <- data_prep %>% 
  filter(question_type %in% c("political", "performance", "nonpolitical")) %>% 
  mutate(question_topic = factor(question_topic, 
                                 levels = c("climate",
                                            "gender",
                                            "immigration",
                                            "discrimination",
                                            "adoption",
                                            "punishment",
                                            "gonogo_performance", 
                                            "fakenews_performance",
                                            "teaculture",
                                            "brain"))) %>%
  droplevels()   

unique(data_full$question_topic)

 [1] adoption             climate              punishment           gender              
 [5] discrimination       gonogo_performance   immigration          teaculture          
 [9] fakenews_performance brain               
10 Levels: climate gender immigration discrimination adoption ... brain

Data types

data_full <- data_full %>%
  mutate(issue_motive_strength = factor(issue_motive_strength,
                                        levels = c("Anti-strong",
                                                   "Anti-moderate",
                                                   "Neutral",
                                                   "Pro-moderate",
                                                   "Pro-strong"),
                                        ordered = TRUE)) 

Data for submodels

data_pol <- data_full %>% 
  filter(question_type == "political") %>% 
  droplevels() 

data_per <- data_full %>% 
  filter(question_type == "performance") %>% 
  droplevels()   

data_neu <- data_full %>% 
  filter(question_type == "nonpolitical") %>% 
  droplevels()  

unique(data_pol$question_topic)

[1] adoption       climate        punishment     gender         discrimination
[6] immigration   
Levels: climate gender immigration discrimination adoption punishment

unique(data_per$question_topic)

[1] gonogo_performance   fakenews_performance
Levels: gonogo_performance fakenews_performance

unique(data_neu$question_topic)

[1] teaculture brain     
Levels: teaculture brain

Table 1: Parameter estimates of interest m1, m3, m4 (logit)

Create a logit table with main parameters of interest of m1, m3, m4.

m1 table

h0a.pol <- hypothesis(m1.pol, "issue_motivePro > 0",
                      alpha = 0.025,
                      seed = 42)

h0a.per <- hypothesis(m1.per, "issue_motivePro > 0",
                      alpha = 0.025,
                      seed = 42)

h0a.neu <- hypothesis(m1.neu, "issue_motivePro > 0",
                      alpha = 0.025,
                      seed = 42)

h0a.pol$hypothesis$Evid.Ratio

[1] Inf

h0a.per$hypothesis$Evid.Ratio

[1] 91

h0a.neu$hypothesis$Evid.Ratio

[1] Inf

h0b.pol <- hypothesis(m1.pol, "issue_motivePro < 0",
                      alpha = 0.025,
                      seed = 42)

h0b.per <- hypothesis(m1.per, "issue_motivePro < 0",
                      alpha = 0.025,
                      seed = 42)

h0b.neu <- hypothesis(m1.neu, "issue_motivePro < 0",
                      alpha = 0.025,
                      seed = 42)

h0b.pol$hypothesis$Evid.Ratio

[1] 0

h0b.per$hypothesis$Evid.Ratio

[1] 0.011

h0b.neu$hypothesis$Evid.Ratio

[1] 0

m1.pol.logit <- describe_posterior(m1.pol, centrality = "median",
                                  ci = 0.95, ci_method = "eti",
                                  diagnostic = c("Rhat"), effects = c("fixed"),
                                  dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h0a.pol$hypothesis$Evid.Ratio,
         "β < 0" = h0b.pol$hypothesis$Evid.Ratio)

m1.per.logit <- describe_posterior(m1.per, centrality = "median",
                                  ci = 0.95, ci_method = "eti",
                                  diagnostic = c("Rhat"), effects = c("fixed"),
                                  dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h0a.per$hypothesis$Evid.Ratio,
         "β < 0" = h0b.per$hypothesis$Evid.Ratio)

m1.neu.logit <- describe_posterior(m1.neu, centrality = "median",
                                  ci = 0.95, ci_method = "eti",
                                  diagnostic = c("Rhat"), effects = c("fixed"),
                                  dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h0a.neu$hypothesis$Evid.Ratio,
         "β < 0" = h0b.neu$hypothesis$Evid.Ratio)

m1.logit <- bind_rows(m1.pol.logit, m1.per.logit, m1.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "b_issue_motivePro") %>% 
  mutate(Parameter = "Motive (Pro > Anti)") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m1.logit

Summary of Posterior Distribution

Question Type |           Parameter | Median |   LL |   UL | β > 0 | β < 0
--------------------------------------------------------------------------
Political     | Motive (Pro > Anti) |   0.36 | 0.26 | 0.47 |   Inf |  0.00
Performance   | Motive (Pro > Anti) |   0.17 | 0.03 | 0.31 | 90.95 |  0.01
Neutral       | Motive (Pro > Anti) |   0.36 | 0.21 | 0.52 |   Inf |  0.00

m3 table

h1a.pol <- hypothesis(m3.pol, "issue_motivePro:scalecrt_correct > 0",
                                alpha = 0.025,
                                seed = 42)

h1a.per <- hypothesis(m3.per, "issue_motivePro:scalecrt_correct > 0", 
                      alpha = 0.025,
                      seed = 42)

h1a.neu <- hypothesis(m3.neu, "issue_motivePro:scalecrt_correct > 0", 
                      alpha = 0.025,
                      seed = 42)

h1a.pol$hypothesis$Evid.Ratio

[1] 0.0492

h1a.per$hypothesis$Evid.Ratio

[1] 0.499

h1a.neu$hypothesis$Evid.Ratio

[1] 0.13

h1b.pol <- hypothesis(m3.pol, "issue_motivePro:scalecrt_correct < 0",
                      alpha = 0.025,
                      seed = 42)

h1b.per <- hypothesis(m3.per, "issue_motivePro:scalecrt_correct < 0", 
                      alpha = 0.025,
                      seed = 42)

h1b.neu <- hypothesis(m3.neu, "issue_motivePro:scalecrt_correct < 0", 
                      alpha = 0.025,
                      seed = 42)

h1b.pol$hypothesis$Evid.Ratio

[1] 20.3

h1b.per$hypothesis$Evid.Ratio

[1] 2.01

h1b.neu$hypothesis$Evid.Ratio

[1] 7.7

m3.pol.logit <- describe_posterior(m3.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h1a.pol$hypothesis$Evid.Ratio,
         "β < 0" = h1b.pol$hypothesis$Evid.Ratio)

m3.per.logit <- describe_posterior(m3.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h1a.per$hypothesis$Evid.Ratio,
         "β < 0" = h1b.per$hypothesis$Evid.Ratio)

m3.neu.logit <- describe_posterior(m3.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h1a.neu$hypothesis$Evid.Ratio,
         "β < 0" = h1b.neu$hypothesis$Evid.Ratio)

m3.logit <- bind_rows(m3.pol.logit, m3.per.logit, m3.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "b_issue_motivePro:scalecrt_correct") %>% 
  mutate(Parameter = "Motive x Cognitive Reflection") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m3.logit

Summary of Posterior Distribution

Question Type |                     Parameter | Median |    LL |   UL | β > 0 | β < 0
-------------------------------------------------------------------------------------
Political     | Motive x Cognitive Reflection |  -0.06 | -0.14 | 0.01 |  0.05 | 20.33
Performance   | Motive x Cognitive Reflection |  -0.03 | -0.18 | 0.12 |  0.50 |  2.00
Neutral       | Motive x Cognitive Reflection |  -0.10 | -0.26 | 0.06 |  0.13 |  7.70

m4 table

h2a.pol <- hypothesis(m4.pol, "issue_motivePro:scalecommission_errors_r > 0",
                      alpha = 0.025,
                      seed = 42)

h2a.per <- hypothesis(m4.per, "issue_motivePro:scalecommission_errors_r > 0", 
                      alpha = 0.025,
                      seed = 42)

h2a.neu <- hypothesis(m4.neu, "issue_motivePro:scalecommission_errors_r > 0",
                      alpha = 0.025,
                      seed = 42)

h2a.pol$hypothesis$Evid.Ratio

[1] 2.71

h2a.per$hypothesis$Evid.Ratio

[1] 0.191

h2a.neu$hypothesis$Evid.Ratio

[1] 63

h2b.pol <- hypothesis(m4.pol, "issue_motivePro:scalecommission_errors_r < 0",
                      alpha = 0.025,
                      seed = 42)

h2b.per <- hypothesis(m4.per, "issue_motivePro:scalecommission_errors_r < 0", 
                      alpha = 0.025,
                      seed = 42)

h2b.neu <- hypothesis(m4.neu, "issue_motivePro:scalecommission_errors_r < 0",
                      alpha = 0.025,
                      seed = 42)

h2b.pol$hypothesis$Evid.Ratio

[1] 0.368

h2b.per$hypothesis$Evid.Ratio

[1] 5.25

h2b.neu$hypothesis$Evid.Ratio

[1] 0.0159

m4.pol.logit <- describe_posterior(m4.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h2a.pol$hypothesis$Evid.Ratio,
         "β < 0" = h2b.pol$hypothesis$Evid.Ratio)

m4.per.logit <- describe_posterior(m4.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h2a.per$hypothesis$Evid.Ratio,
         "β < 0" = h2b.per$hypothesis$Evid.Ratio)

m4.neu.logit <- describe_posterior(m4.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h2a.neu$hypothesis$Evid.Ratio,
         "β < 0" = h2b.neu$hypothesis$Evid.Ratio)

m4.logit <- bind_rows(m4.pol.logit, m4.per.logit, m4.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "b_issue_motivePro:scalecommission_errors_r") %>% 
  mutate(Parameter = "Motive x Inhibitory Control") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m4.logit

Summary of Posterior Distribution

Question Type |                   Parameter | Median |    LL |   UL | β > 0 | β < 0
-----------------------------------------------------------------------------------
Political     | Motive x Inhibitory Control |   0.02 | -0.05 | 0.10 |  2.71 |  0.37
Performance   | Motive x Inhibitory Control |  -0.07 | -0.23 | 0.07 |  0.19 |  5.25
Neutral       | Motive x Inhibitory Control |   0.17 |  0.01 | 0.33 | 63.00 |  0.02

Combined table

combined_logit <- bind_rows(m1.logit, m3.logit, m4.logit) %>% 
  mutate(`Question Type` = factor(`Question Type`, levels = c("Political", "Performance", "Neutral"))) %>% 
  arrange(`Question Type`, Parameter)

combined_logit_table <- combined_logit %>% 
  select(-c("Question Type")) %>% 
  tt() %>% 
  group_tt(
    i = list(
      "Political Vignettes" = 1,
      "Performance Vignettes" = 4,
      "Neutral Vignettes" = 7
    ),
    j = list(
      "95% CI" = 3:4,
      "Evidence Ratio" = 5:6))

combined_logit_table %>% save_tt(here(table_dir, "combined_logit_table.docx"), overwrite = TRUE)

combined_logit_table

		95% CI		Evidence Ratio
Parameter	Median	LL	UL	β > 0	β < 0
Motive (Pro > Anti)	0.363	0.258	0.475	Inf	0.000
Motive x Cognitive Reflection	-0.063	-0.139	0.010	0.049	20.333
Motive x Inhibitory Control	0.024	-0.049	0.100	2.714	0.368
Motive (Pro > Anti)	0.169	0.025	0.312	90.954	0.011
Motive x Cognitive Reflection	-0.033	-0.180	0.116	0.499	2.005
Motive x Inhibitory Control	-0.075	-0.232	0.075	0.191	5.245
Motive (Pro > Anti)	0.361	0.209	0.517	Inf	0.000
Motive x Cognitive Reflection	-0.097	-0.261	0.060	0.130	7.696
Motive x Inhibitory Control	0.173	0.012	0.329	63.000	0.016

Main Text: Reported Percentage Predictions m1, m3

m1: Pro vs. Anti in %

Calculate % comparisons

m1.pol.com <- m1.pol %>% 
  avg_comparisons() %>% 
  as_tibble() %>% 
  select(contrast, estimate, conf.low, conf.high) %>%
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(contrast = recode(contrast,
                           "mean(Pro) - mean(Anti)" = "Pro - Anti"),
         "Question Type" = "Political") %>%
  rename("Contrast" = "contrast",
         "Estimate" = "estimate",
         "LL" = "conf.low",
         "UL" = "conf.high")

m1.per.com <- m1.per %>% 
  avg_comparisons() %>% 
  as_tibble() %>% 
  select(contrast, estimate, conf.low, conf.high) %>%
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(contrast = recode(contrast,
                           "mean(Pro) - mean(Anti)" = "Pro - Anti"),
         "Question Type" = "Performance") %>%
  rename("Contrast" = "contrast",
         "Estimate" = "estimate",
         "LL" = "conf.low",
         "UL" = "conf.high")

m1.neu.com <- m1.neu %>% 
  avg_comparisons() %>% 
  as_tibble() %>% 
  select(contrast, estimate, conf.low, conf.high) %>%
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(contrast = recode(contrast,
                           "mean(Pro) - mean(Anti)" = "Pro - Anti"),
         "Question Type" = "Neutral") %>%
  rename("Contrast" = "contrast",
         "Estimate" = "estimate",
         "LL" = "conf.low",
         "UL" = "conf.high")

Combined table

m1.combined_perc <- bind_rows(m1.pol.com, m1.per.com, m1.neu.com) %>% 
  mutate(`Question Type` = factor(`Question Type`, levels = c("Political", "Performance", "Neutral"))) 

m1.combined_perc_table <- m1.combined_perc %>% 
  select(-c("Question Type")) %>% 
  tt() %>% 
  group_tt(
    i = list(
      "Political Vignettes" = 1,
      "Performance Vignettes" = 2,
      "Neutral Vignettes" = 3
    ),
    j = list(
      "95% CI" = 3:4))

m1.combined_perc_table %>% save_tt(here(table_dir, "m1_combined_perc_table.docx"), overwrite = TRUE)

m1.combined_perc_table

		95% CI
Contrast	Estimate	LL	UL
Pro - Anti	0.0923	0.0741	0.1105
Pro - Anti	0.0419	0.0079	0.0757
Pro - Anti	0.0944	0.0571	0.1322

m3: Pro vs. Anti for CRT = 3 and CRT = 0 in %

crt.newdata <- 
  expand_grid(issue_motive = c("Pro", "Anti"),
              crt_correct = c(0, 3))

m3.pol.com <- m3.pol %>%
    epred_draws(newdata = crt.newdata,
                re_formula = NA) %>% 
    group_by(crt_correct) %>% 
    compare_levels(.epred, by = issue_motive) %>% 
    compare_levels(.epred, by = crt_correct) %>% 
    median_qi(.width = 0.95)

m3.pol.com %>% tt()

crt_correct	issue_motive	.epred	.lower	.upper	.width	.point	.interval
3 - 0	Pro - Anti	-0.0418	-0.0922	0.00625	0.95	median	qi

Figure: Motivated Reasoning on Different Topics

Extract draws

Average effect of motivated reasoning on political, performance, and neutral topics

m1.pol.draws <- m1.pol %>%
  avg_comparisons(variables = "issue_motive") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Political",
         question_topic = "average")

m1.pol.draws %>% median_hdi(draw)

# A tibble: 1 × 6
    draw .lower .upper .width .point .interval
   <dbl>  <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 0.0923 0.0746  0.111   0.95 median hdi      

m1.per.draws <- m1.per %>%
  avg_comparisons(variables = "issue_motive") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Performance",
         question_topic = "average")

m1.per.draws %>% median_hdi(draw)

# A tibble: 1 × 6
    draw  .lower .upper .width .point .interval
   <dbl>   <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 0.0419 0.00833 0.0760   0.95 median hdi      

m1.neu.draws <- m1.neu %>%
  avg_comparisons(variables = "issue_motive") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Neutral",
         question_topic = "average")

m1.neu.draws %>% median_hdi(draw)

# A tibble: 1 × 6
    draw .lower .upper .width .point .interval
   <dbl>  <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 0.0944 0.0568  0.132   0.95 median hdi      

Motivated reasoning by topic

m1.pol.topic <- avg_comparisons(m1.pol,
                                variables = "issue_motive",
                                by = "question_topic") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Political")
  
m1.pol.topic %>% group_by(question_topic) %>% median_hdi(draw)

# A tibble: 6 × 7
  question_topic   draw .lower .upper .width .point .interval
  <fct>           <dbl>  <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 climate        0.0986 0.0715  0.129   0.95 median hdi      
2 gender         0.0918 0.0644  0.119   0.95 median hdi      
3 immigration    0.0933 0.0647  0.123   0.95 median hdi      
4 discrimination 0.0987 0.0706  0.131   0.95 median hdi      
5 adoption       0.0917 0.0644  0.122   0.95 median hdi      
6 punishment     0.0798 0.0424  0.110   0.95 median hdi      

m1.per.topic <- avg_comparisons(m1.per,
                                variables = "issue_motive",
                                by = "question_topic") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Performance")
  
m1.per.topic %>% group_by(question_topic) %>% median_hdi(draw)

# A tibble: 2 × 7
  question_topic         draw   .lower .upper .width .point .interval
  <fct>                 <dbl>    <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 gonogo_performance   0.0398 -0.0108  0.0840   0.95 median hdi      
2 fakenews_performance 0.0440 -0.00235 0.0955   0.95 median hdi      

m1.neu.topic <- avg_comparisons(m1.neu,
                                variables = "issue_motive",
                                by = "question_topic") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") %>% 
  mutate(question_type = "Neutral")
  
m1.neu.topic %>% group_by(question_topic) %>% median_hdi(draw)

# A tibble: 2 × 7
  question_topic   draw  .lower .upper .width .point .interval
  <fct>           <dbl>   <dbl>  <dbl>  <dbl> <chr>  <chr>    
1 teaculture     0.137   0.0866  0.187   0.95 median hdi      
2 brain          0.0442 -0.0121  0.101   0.95 median hdi      

Create a combined dataframe

m1.combined <- bind_rows(m1.pol.draws, m1.pol.topic, 
                         m1.per.draws, m1.per.topic,
                         m1.neu.draws, m1.neu.topic)

m1.combined <- m1.combined %>% 
  mutate(question_topic = factor(question_topic,
                                 levels = c("brain",
                                            "teaculture", 
                                            "fakenews_performance", 
                                            "gonogo_performance",
                                            "punishment",
                                            "adoption", 
                                            "discrimination",
                                            "gender",
                                            "immigration",
                                            "climate", 
                                            "average"),
                                 labels = c("Brain proportion",
                                            "Tea with milk",
                                            "Fake News performance",
                                            "Go / No-Go performance",
                                            "Criminal reconviction",
                                            "Same-sex adoption",
                                            "Racial discrimination",
                                            "Gender stereotypes",
                                            "Immigrant population",
                                            "Anthropogenic climate change",
                                            "Average"
                                            )),
         draw_perc = draw*100) 

Create figure

average_color <- "#645CAA"

plot_political <- m1.combined %>%
  filter(question_type == "Political") %>%
  ggplot(aes(x = draw_perc, y = question_topic, 
             fill = question_topic == "Average")) +
  stat_halfeye(slab_alpha = 0.9, .width = c(0.5, 0.95), 
               point_interval = "median_qi") +
  geom_vline(xintercept = 0, alpha = 0.8, linewidth = 0.8, 
             color = "black", linetype = "dashed") +
  scale_fill_manual(values = c(`TRUE` = average_color, `FALSE` = "#A685E2")) +
  labs(subtitle = "Political Vignettes",
       x = NULL, y = NULL) +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(-10, 25),
                     breaks = seq(-10, 20, by = 5)) +
  theme_ipsum_rc(base_size = 16,
                 subtitle_size = 18,
                 subtitle_face = "bold",
                 axis_text_size = 16,
                 grid = "XY") +
  guides(fill = "none") +
  theme(legend.position = "none")

plot_performance <- m1.combined %>%
  filter(question_type == "Performance") %>%
  ggplot(aes(x = draw_perc, y = question_topic, 
             fill = question_topic == "Average")) +
  stat_halfeye(slab_alpha = 0.9, .width = c(0.5, 0.95), 
               point_interval = "median_qi") +
  geom_vline(xintercept = 0, alpha = 0.8, linewidth = 0.8, 
             color = "black", linetype = "dashed") +
  scale_fill_manual(values = c(`TRUE` = average_color, `FALSE` = "#FF8DC7")) +
  labs(subtitle = "Performance Vignettes",
       x = NULL, y = NULL) +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(-10, 25)) +
  theme_ipsum_rc(base_size = 16,
                 subtitle_size = 18,
                 subtitle_face = "bold",
                 axis_text_size = 16,
                 grid = "XY") +
  guides(fill = "none") +
  theme(legend.position = "none")

plot_neutral <- m1.combined %>%
  filter(question_type == "Neutral") %>%
  ggplot(aes(x = draw_perc, y = question_topic, 
             fill = question_topic == "Average")) +
  stat_halfeye(slab_alpha = 0.9, .width = c(0.5, 0.95), 
               point_interval = "median_qi") +
  geom_vline(xintercept = 0, alpha = 0.8, linewidth = 0.8, 
             color = "black", linetype = "dashed") +
  scale_fill_manual(values = c(`TRUE` = average_color, `FALSE` = "#FFABE1")) +
  labs(subtitle = "Neutral Vignettes",
       x = NULL, y = NULL) +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(-10, 25)) +
  theme_ipsum_rc(base_size = 16,
                 subtitle_size = 18,
                 subtitle_face = "bold",
                 axis_text_size = 16,
                 grid = "XY") +
  guides(fill = "none") +
  theme(legend.position = "none")

main_effect_plot <- plot_political / (plot_performance | plot_neutral) +
  plot_layout(heights = c(2, 1))

main_effect_plot

ggsave(here(fig_dir, "m1_main_fig.png"), width = 12, height = 10, dpi = 300)

Figure: The link to cognitive control variables

Extract political draws

m3.pol.draws <- avg_comparisons(m3.pol,
                   variables = "issue_motive",
                   by = "crt_correct") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") 

m3.pol.draws %>% group_by(crt_correct) %>% median_hdi(draw)

# A tibble: 4 × 7
  crt_correct   draw .lower .upper .width .point .interval
        <dbl>  <dbl>  <dbl>  <dbl>  <dbl> <chr>  <chr>    
1           0 0.115  0.0834  0.147   0.95 median hdi      
2           1 0.101  0.0779  0.122   0.95 median hdi      
3           2 0.0878 0.0677  0.109   0.95 median hdi      
4           3 0.0738 0.0458  0.102   0.95 median hdi      

m4.pol.draws <- avg_comparisons(m4.pol,
                   variables = "issue_motive",
                   by = "commission_errors_r",
                   newdata = expand_grid(issue_motive = c("Pro", "Anti"),
                                         commission_errors_r = seq(13, 56)),
                   re_formula = NA) %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") 

Warning: The `issue_motive` variable is treated as a categorical (factor) variable, but
  the original data is of class character. It is safer and faster to convert such
  variables to factor before fitting the model and calling a `marginaleffects`
  function.
  
  This warning appears once per session.

m4.pol.draws %>% group_by(commission_errors_r) %>% median_hdi(draw)

# A tibble: 44 × 7
   commission_errors_r   draw .lower .upper .width .point .interval
                 <int>  <dbl>  <dbl>  <dbl>  <dbl> <chr>  <chr>    
 1                  13 0.0759 0.0108  0.137   0.95 median hdi      
 2                  14 0.0767 0.0161  0.138   0.95 median hdi      
 3                  15 0.0775 0.0176  0.135   0.95 median hdi      
 4                  16 0.0781 0.0211  0.135   0.95 median hdi      
 5                  17 0.0788 0.0234  0.133   0.95 median hdi      
 6                  18 0.0796 0.0259  0.132   0.95 median hdi      
 7                  19 0.0803 0.0304  0.133   0.95 median hdi      
 8                  20 0.0810 0.0327  0.131   0.95 median hdi      
 9                  21 0.0817 0.0343  0.128   0.95 median hdi      
10                  22 0.0825 0.0374  0.128   0.95 median hdi      
# ℹ 34 more rows

Create political figures

pol_crt_plot <- m3.pol.draws %>%
  mutate(draw_perc = draw * 100) %>% 
  ggplot(aes(x = crt_correct, y = draw_perc, fill = factor(crt_correct))) +
  stat_slabinterval(aes(ymin = conf.low * 100, ymax = conf.high * 100),  
    .width = c(0.5, 0.95), 
    alpha = 0.7,
    position = position_dodge(width = 0.5)) +
  scale_fill_manual(values = c("#E1AFD1", "#AD88C6", "#7469B6", "#6A2C70")) +
  labs(title = "Cognitive Reflection and Motivated Reasoning",
    subtitle = glue("Political vignettes (Evid.Ratio H1a > H1b = {round(h1a.pol$hypothesis$Evid.Ratio, 2)})"),
    x = "Cognitive Reflection",
    y = "Motivated Reasoning") +
  scale_x_continuous(breaks = c(0, 1, 2, 3)) +
  scale_y_continuous(breaks = c(-5, 0, 5, 10, 15, 20, 25),
                     labels = percent_format(scale = 1)) +
  theme_ipsum_rc(base_size = 14,
                 plot_title_size = 16,
                 plot_title_face = "bold",
                 axis_title_size = 14,
                 axis_text_size = 14,
                 grid = "XY") +
  theme(legend.position = "none")

pol_crt_plot

alt_pol_crt_plot <- m3.pol.draws %>% 
  mutate(draw_perc = draw * 100) %>% 
  ggplot(aes(x = crt_correct, y = draw_perc)) +
  stat_lineribbon(.width = c(0.5, 0.95), alpha = 0.6) + 
  scale_fill_manual(values = c("#AD88C6", "#7469B6")) +
  labs(title = "Cognitive Reflection and Motivated Reasoning",
    subtitle = glue("Political vignettes (Evid.Ratio H2a > H2b = {round(h1a.pol$hypothesis$Evid.Ratio, 2)})"),
       x = "Cognitive Reflection", 
       y = "Motivated Reasoning",
       fill = "Credible interval") +
  scale_x_continuous(breaks = c(0, 1, 2, 3)) +
  scale_y_continuous(breaks = c(-5, 0, 5, 10, 15, 20, 25),
                     labels = percent_format(scale = 1)) +
  theme_ipsum_rc(base_size = 14,
                 plot_title_size = 16,
                 plot_title_face = "bold",
                 axis_title_size = 14,
                 axis_text_size = 14,
                 grid = "XY"
                 ) +
  theme(legend.position = "top")

alt_pol_crt_plot

pol_gng_plot <- m4.pol.draws %>% 
  mutate(draw_perc = draw * 100) %>% 
  ggplot(aes(x = commission_errors_r, y = draw_perc)) +
  stat_lineribbon(.width = c(0.5, 0.95), alpha = 0.6) + 
  scale_fill_manual(values = c("#AD88C6", "#7469B6")) +
  labs(title = "Inhibitory Control and Motivated Reasoning",
    subtitle = glue("Political vignettes (Evid.Ratio H2a > H2b = {round(h2a.pol$hypothesis$Evid.Ratio, 2)})"),
       x = "Inhibitory Control", 
       y = "Motivated Reasoning",
       fill = "Credible interval") +
  scale_x_continuous(breaks = seq(15, 55, by = 10)) +
  scale_y_continuous(breaks = c(-5, 0, 5, 10, 15, 20, 25),
                     labels = percent_format(scale = 1)) +
  theme_ipsum_rc(base_size = 14,
                 plot_title_size = 16,
                 plot_title_face = "bold",
                 axis_title_size = 14,
                 axis_text_size = 14,
                 grid = "XY"
                 ) +
  theme(legend.position = "top")

pol_gng_plot

Extract performance and neutral draws

m3.per.draws <- avg_comparisons(m3.per,
                   variables = "issue_motive",
                   by = "crt_correct") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") 

m3.per.draws %>% group_by(crt_correct) %>% median_hdi(draw)

# A tibble: 4 × 7
  crt_correct   draw   .lower .upper .width .point .interval
        <dbl>  <dbl>    <dbl>  <dbl>  <dbl> <chr>  <chr>    
1    2.22e-16 0.0525 -0.00789 0.112    0.95 median hdi      
2    1   e+ 0 0.0477  0.00366 0.0963   0.95 median hdi      
3    2   e+ 0 0.0358 -0.00619 0.0763   0.95 median hdi      
4    3   e+ 0 0.0339 -0.0197  0.0903   0.95 median hdi      

m3.neu.draws <- avg_comparisons(m3.neu,
                   variables = "issue_motive",
                   by = "crt_correct") %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") 

m3.neu.draws %>% group_by(crt_correct) %>% median_hdi(draw)

# A tibble: 4 × 7
  crt_correct   draw  .lower .upper .width .point .interval
        <dbl>  <dbl>   <dbl>  <dbl>  <dbl> <chr>  <chr>    
1           0 0.129  0.0655   0.195   0.95 median hdi      
2           1 0.108  0.0606   0.151   0.95 median hdi      
3           2 0.0852 0.0410   0.127   0.95 median hdi      
4           3 0.0650 0.00509  0.127   0.95 median hdi      

m4.per.draws <- avg_comparisons(m4.per,
                   variables = "issue_motive",
                   by = "commission_errors_r",
                   newdata = expand_grid(issue_motive = c("Pro", "Anti"),
                                         commission_errors_r = seq(13, 56),
                                         question_topic = levels(data_per$question_topic)),
                   re_formula = NA) %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") 

m4.per.draws %>% group_by(commission_errors_r) %>% median_hdi(draw)

# A tibble: 44 × 7
   commission_errors_r   draw   .lower .upper .width .point .interval
                 <int>  <dbl>    <dbl>  <dbl>  <dbl> <chr>  <chr>    
 1                  13 0.0992 -0.0152   0.217   0.95 median hdi      
 2                  14 0.0971 -0.0149   0.209   0.95 median hdi      
 3                  15 0.0949 -0.0128   0.203   0.95 median hdi      
 4                  16 0.0929 -0.0107   0.196   0.95 median hdi      
 5                  17 0.0908 -0.00827  0.190   0.95 median hdi      
 6                  18 0.0886 -0.00711  0.183   0.95 median hdi      
 7                  19 0.0865 -0.00369  0.178   0.95 median hdi      
 8                  20 0.0842 -0.00266  0.171   0.95 median hdi      
 9                  21 0.0819 -0.00112  0.165   0.95 median hdi      
10                  22 0.0796  0.00161  0.159   0.95 median hdi      
# ℹ 34 more rows

m4.neu.draws <- avg_comparisons(m4.neu,
                   variables = "issue_motive",
                   by = "commission_errors_r",
                   newdata = expand_grid(issue_motive = c("Pro", "Anti"),
                                         commission_errors_r = seq(13, 56),
                                         question_topic = levels(data_neu$question_topic)),
                   re_formula = NA) %>% 
  posterior_draws() %>% 
  filter(contrast == "mean(Pro) - mean(Anti)") 

m4.neu.draws %>% group_by(commission_errors_r) %>% median_hdi(draw)

# A tibble: 44 × 7
   commission_errors_r     draw  .lower .upper .width .point .interval
                 <int>    <dbl>   <dbl>  <dbl>  <dbl> <chr>  <chr>    
 1                  13 -0.0353  -0.155  0.0863   0.95 median hdi      
 2                  14 -0.0300  -0.149  0.0837   0.95 median hdi      
 3                  15 -0.0247  -0.135  0.0893   0.95 median hdi      
 4                  16 -0.0193  -0.126  0.0889   0.95 median hdi      
 5                  17 -0.0140  -0.117  0.0904   0.95 median hdi      
 6                  18 -0.00864 -0.107  0.0915   0.95 median hdi      
 7                  19 -0.00318 -0.0979 0.0923   0.95 median hdi      
 8                  20  0.00223 -0.0885 0.0934   0.95 median hdi      
 9                  21  0.00764 -0.0771 0.0966   0.95 median hdi      
10                  22  0.0130  -0.0683 0.0967   0.95 median hdi      
# ℹ 34 more rows

Create performance and neutral figures

per_crt_plot <- m3.per.draws %>%
  mutate(draw_perc = draw * 100) %>% 
  ggplot(aes(x = crt_correct, y = draw_perc, fill = factor(crt_correct))) +
  stat_slabinterval(aes(ymin = conf.low * 100, ymax = conf.high * 100),  
    .width = c(0.5, 0.95), 
    alpha = 0.7,
    position = position_dodge(width = 0.5)) +
  scale_fill_manual(values = c("#E1AFD1", "#AD88C6", "#7469B6", "#6A2C70")) +
  labs(subtitle = glue("Performance vignettes 
(Evid.Ratio H1a > H1b = {round(h1a.per$hypothesis$Evid.Ratio, 2)})"),
       x = NULL, 
       y = NULL) +
  scale_x_continuous(breaks = c(0, 1, 2, 3)) +
  scale_y_continuous(breaks = c(-5, 0, 5, 10, 15, 20, 25),
                     labels = percent_format(scale = 1)) +
  theme_ipsum_rc(base_size = 14,
                 plot_title_size = 16,
                 axis_title_size = 14,
                 axis_text_size = 14,
                 grid = "XY") +
  theme(legend.position = "none")

per_crt_plot

alt_per_crt_plot <- m3.per.draws %>% 
  mutate(draw_perc = draw * 100) %>% 
  ggplot(aes(x = crt_correct, y = draw_perc)) +
  stat_lineribbon(.width = c(0.5, 0.95), alpha = 0.6) + 
  scale_fill_manual(values = c("#AD88C6", "#7469B6")) +
  labs(subtitle = glue("Performance vignettes 
(Evid.Ratio H1a > H1b = {round(h1a.per$hypothesis$Evid.Ratio, 2)})"),
       x = NULL, 
       y = NULL) +
  scale_x_continuous(breaks = c(0, 1, 2, 3)) +
  scale_y_continuous(breaks = c(-5, 0, 5, 10, 15, 20, 25),
                     labels = percent_format(scale = 1)) +
  theme_ipsum_rc(base_size = 14,
                 plot_title_size = 16,
                 axis_title_size = 14,
                 axis_text_size = 14,
                 grid = "XY") +
  theme(legend.position = "none")

alt_per_crt_plot

neu_crt_plot <- m3.neu.draws %>%
  mutate(draw_perc = draw * 100) %>% 
  ggplot(aes(x = crt_correct, y = draw_perc, fill = factor(crt_correct))) +
  stat_slabinterval(aes(ymin = conf.low * 100, ymax = conf.high * 100),  
    .width = c(0.5, 0.95), 
    alpha = 0.7,
    position = position_dodge(width = 0.5)) +
  scale_fill_manual(values = c("#E1AFD1", "#AD88C6", "#7469B6", "#6A2C70")) +
  labs(subtitle = glue("Neutral vignettes 
(Evid.Ratio H1a > H1b = {round(h1a.neu$hypothesis$Evid.Ratio, 2)})"),
       x = NULL, 
       y = NULL) +
  scale_x_continuous(breaks = c(0, 1, 2, 3)) +
  scale_y_continuous(breaks = c(-5, 0, 5, 10, 15, 20, 25),
                     labels = percent_format(scale = 1)) +
  theme_ipsum_rc(base_size = 14,
                 plot_title_size = 16,
                 axis_title_size = 14,
                 axis_text_size = 14,
                 grid = "XY") +
  theme(legend.position = "none")

neu_crt_plot

per_gng_plot <- m4.per.draws %>% 
  mutate(draw_perc = draw * 100) %>% 
  ggplot(aes(x = commission_errors_r, y = draw_perc)) +
  stat_lineribbon(.width = c(0.5, 0.95), alpha = 0.6) + 
  scale_fill_manual(values = c("#AD88C6", "#7469B6")) +
  labs(subtitle = glue("Performance vignettes 
(Evid.Ratio H2a > H2b = {round(h2a.per$hypothesis$Evid.Ratio, 2)})"),
       x = NULL, 
       y = NULL) +
  scale_x_continuous(breaks = seq(15, 55, by = 10)) +
  scale_y_continuous(breaks = c(-5, 0, 5, 10, 15, 20, 25),
                     labels = percent_format(scale = 1)) +
  theme_ipsum_rc(base_size = 14,
                 plot_title_size = 16,
                 axis_title_size = 14,
                 axis_text_size = 14,
                 grid = "XY"
                 ) +
  theme(legend.position = "none")

per_gng_plot

neu_gng_plot <- m4.neu.draws %>% 
  mutate(draw_perc = draw * 100) %>% 
  ggplot(aes(x = commission_errors_r, y = draw_perc)) +
  stat_lineribbon(.width = c(0.5, 0.95), alpha = 0.6) + 
  scale_fill_manual(values = c("#AD88C6", "#7469B6")) +
  labs(subtitle = glue("Neutral vignettes 
(Evid.Ratio H2a > H2b = {round(h2a.neu$hypothesis$Evid.Ratio, 2)})"),
       x = NULL, 
       y = NULL) +
  scale_x_continuous(breaks = seq(15, 55, by = 10)) +
  scale_y_continuous(breaks = c(-5, 0, 5, 10, 15, 20, 25),
                     labels = percent_format(scale = 1)) +
  theme_ipsum_rc(base_size = 14,
                 plot_title_size = 16,
                 axis_title_size = 14,
                 axis_text_size = 14,
                 grid = "XY"
                 ) +
  theme(legend.position = "none")

neu_gng_plot

Combined plot

top_panel <- pol_crt_plot + pol_gng_plot +
  plot_layout(ncol = 2, widths = c(1, 1))

bottom_left <- per_crt_plot + neu_crt_plot +
  plot_layout(heights = c(1, 1), widths = c(0.5, 0.5))

bottom_right <- per_gng_plot + neu_gng_plot +
  plot_layout(heights = c(1, 1), widths = c(1.5, 1.5))

cognitive_plot <- (top_panel / (bottom_left | bottom_right)) +
  plot_layout(heights = c(1.5, 2)) 

cognitive_plot

ggsave(here(fig_dir, "cognitive_fig.png"), width = 12, height = 10, dpi = 300)

Supplementary Table 3

Create a logit table with main parameters of interest of m2, m5, m6.

m2 table

h0a_mo.pol <- as_tibble(m2.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength > 0",
                      alpha = 0.025,
                      seed = 42)


h0a_mo.per <- as_tibble(m2.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength > 0",
                      alpha = 0.025,
                      seed = 42)

h0a_mo.neu <- as_tibble(m2.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength > 0",
                      alpha = 0.025,
                      seed = 42)

h0a_mo.pol$hypothesis$Evid.Ratio

[1] Inf

h0a_mo.per$hypothesis$Evid.Ratio

[1] 399

h0a_mo.neu$hypothesis$Evid.Ratio

[1] Inf

h0b_mo.pol <- as_tibble(m2.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength < 0",
             alpha = 0.025,
             seed = 42)


h0b_mo.per <- as_tibble(m2.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength < 0",
             alpha = 0.025,
             seed = 42)

h0b_mo.neu <- as_tibble(m2.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength < 0",
             alpha = 0.025,
             seed = 42)

h0b_mo.pol$hypothesis$Evid.Ratio

[1] 0

h0b_mo.per$hypothesis$Evid.Ratio

[1] 0.00251

h0b_mo.neu$hypothesis$Evid.Ratio

[1] 0

m2.pol.logit <- describe_posterior(m2.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h0a_mo.pol$hypothesis$Evid.Ratio,
         "β < 0" = h0b_mo.pol$hypothesis$Evid.Ratio)

m2.per.logit <- describe_posterior(m2.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h0a_mo.per$hypothesis$Evid.Ratio,
         "β < 0" = h0b_mo.per$hypothesis$Evid.Ratio)

m2.neu.logit <- describe_posterior(m2.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h0a_mo.neu$hypothesis$Evid.Ratio,
         "β < 0" = h0b_mo.neu$hypothesis$Evid.Ratio)

m2.logit <- bind_rows(m2.pol.logit, m2.per.logit, m2.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "bsp_moissue_motive_strength") %>% 
  mutate(Parameter = "Motive strength") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m2.logit

Summary of Posterior Distribution

Question Type |       Parameter | Median |   LL |   UL |  β > 0 |    β < 0
--------------------------------------------------------------------------
Political     | Motive strength |   0.12 | 0.09 | 0.15 |    Inf |     0.00
Performance   | Motive strength |   0.12 | 0.03 | 0.22 | 399.00 | 3.00e-03
Neutral       | Motive strength |   0.13 | 0.07 | 0.19 |    Inf |     0.00

m5 table

h1a_mo.pol <- as_tibble(m5.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct > 0",
                      alpha = 0.025,
                      seed = 42)

h1a_mo.per <- as_tibble(m5.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct > 0", 
                      alpha = 0.025,
                      seed = 42)

h1a_mo.neu <- as_tibble(m5.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct > 0", 
                      alpha = 0.025,
                      seed = 42)

h1a_mo.pol$hypothesis$Evid.Ratio

[1] 0.0382

h1a_mo.per$hypothesis$Evid.Ratio

[1] 0.315

h1a_mo.neu$hypothesis$Evid.Ratio

[1] 0.321

h1b_mo.pol <- as_tibble(m5.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct < 0",
             alpha = 0.025,
             seed = 42)

h1b_mo.per <- as_tibble(m5.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct < 0", 
             alpha = 0.025,
             seed = 42)

h1b_mo.neu <- as_tibble(m5.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecrt_correct < 0", 
             alpha = 0.025,
             seed = 42)

h1b_mo.pol$hypothesis$Evid.Ratio

[1] 26.2

h1b_mo.per$hypothesis$Evid.Ratio

[1] 3.18

h1b_mo.neu$hypothesis$Evid.Ratio

[1] 3.12

m5.pol.logit <- describe_posterior(m5.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h1a_mo.pol$hypothesis$Evid.Ratio,
         "β < 0" = h1b_mo.pol$hypothesis$Evid.Ratio)

m5.per.logit <- describe_posterior(m5.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h1a_mo.per$hypothesis$Evid.Ratio,
         "β < 0" = h1b_mo.per$hypothesis$Evid.Ratio)

m5.neu.logit <- describe_posterior(m5.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h1a_mo.neu$hypothesis$Evid.Ratio,
         "β < 0" = h1b_mo.neu$hypothesis$Evid.Ratio)

m5.logit <- bind_rows(m5.pol.logit, m5.per.logit, m5.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "bsp_moissue_motive_strength:scalecrt_correct") %>% 
  mutate(Parameter = "Motive strength x Cognitive Reflection") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m5.logit

Summary of Posterior Distribution

Question Type |                              Parameter | Median |    LL |       UL | β > 0 | β < 0
--------------------------------------------------------------------------------------------------
Political     | Motive strength x Cognitive Reflection |  -0.02 | -0.05 | 2.00e-03 |  0.04 | 26.21
Performance   | Motive strength x Cognitive Reflection |  -0.02 | -0.10 |     0.04 |  0.32 |  3.17
Neutral       | Motive strength x Cognitive Reflection |  -0.02 | -0.07 |     0.04 |  0.32 |  3.12

m6 table

h2a_mo.pol <- as_tibble(m6.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r > 0",
                      alpha = 0.025,
                      seed = 42)

h2a_mo.per <- as_tibble(m6.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r > 0", 
                      alpha = 0.025,
                      seed = 42)

h2a_mo.neu <- as_tibble(m6.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r > 0",
                      alpha = 0.025,
                      seed = 42)

h2a_mo.pol$hypothesis$Evid.Ratio

[1] 3.55

h2a_mo.per$hypothesis$Evid.Ratio

[1] 0.429

h2a_mo.neu$hypothesis$Evid.Ratio

[1] 95.4

h2b_mo.pol <- as_tibble(m6.pol) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r < 0",
             alpha = 0.025,
             seed = 42)

h2b_mo.per <- as_tibble(m6.per) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r < 0", 
             alpha = 0.025,
             seed = 42)

h2b_mo.neu <- as_tibble(m6.neu) %>% 
  hypothesis(., "bsp_moissue_motive_strength:scalecommission_errors_r < 0",
             alpha = 0.025,
             seed = 42)

h2b_mo.pol$hypothesis$Evid.Ratio

[1] 0.282

h2b_mo.per$hypothesis$Evid.Ratio

[1] 2.33

h2b_mo.neu$hypothesis$Evid.Ratio

[1] 0.0105

m6.pol.logit <- describe_posterior(m6.pol, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Political") %>% 
  mutate("β > 0" = h2a_mo.pol$hypothesis$Evid.Ratio,
         "β < 0" = h2b_mo.pol$hypothesis$Evid.Ratio)

m6.per.logit <- describe_posterior(m6.per, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Performance") %>% 
  mutate("β > 0" = h2a_mo.per$hypothesis$Evid.Ratio,
         "β < 0" = h2b_mo.per$hypothesis$Evid.Ratio)

m6.neu.logit <- describe_posterior(m6.neu, centrality = "median",
                                   ci = 0.95, ci_method = "eti",
                                   diagnostic = c("Rhat"), effects = c("fixed"),
                                   dispersion = FALSE, test = NULL) %>% 
  mutate("Question Type" = "Neutral") %>% 
  mutate("β > 0" = h2a_mo.neu$hypothesis$Evid.Ratio,
         "β < 0" = h2a_mo.neu$hypothesis$Evid.Ratio)

m6.logit <- bind_rows(m6.pol.logit, m6.per.logit, m6.neu.logit) %>% 
  select("Question Type", Parameter, Median, 
         CI_low, CI_high, "β > 0", "β < 0") %>% 
  rename("LL" = CI_low,
         "UL" = CI_high) %>% 
  filter(Parameter == "bsp_moissue_motive_strength:scalecommission_errors_r") %>% 
  mutate(Parameter = "Motive strength x Inhibitory Control") %>% 
  mutate(across(where(is.numeric), ~ round(.x, 3)))

m6.logit

Summary of Posterior Distribution

Question Type |                            Parameter |   Median |    LL |   UL | β > 0 | β < 0
----------------------------------------------------------------------------------------------
Political     | Motive strength x Inhibitory Control | 9.00e-03 | -0.01 | 0.03 |  3.55 |  0.28
Performance   | Motive strength x Inhibitory Control |    -0.02 | -0.08 | 0.06 |  0.43 |  2.33
Neutral       | Motive strength x Inhibitory Control |     0.06 |  0.01 | 0.12 | 95.39 | 95.39

Combined table

combined_mo_logit <- bind_rows(m2.logit, m5.logit, m6.logit) %>% 
  mutate(`Question Type` = factor(`Question Type`, levels = c("Political", "Performance", "Neutral"))) %>% 
  arrange(`Question Type`, Parameter)

combined_mo_logit_table <- combined_mo_logit %>% 
  select(-c("Question Type")) %>% 
  tt() %>% 
  group_tt(
    i = list(
      "Political Vignettes" = 1,
      "Performance Vignettes" = 4,
      "Neutral Vignettes" = 7
    ),
    j = list(
      "95% CI" = 3:4,
      "Evidence Ratio" = 5:6))

combined_mo_logit_table %>% save_tt(here(table_dir, "combined_mo_logit_table.docx"), overwrite = TRUE)

combined_mo_logit_table

		95% CI		Evidence Ratio
Parameter	Median	LL	UL	β > 0	β < 0
Motive strength	0.118	0.085	0.151	Inf	0.000
Motive strength x Cognitive Reflection	-0.022	-0.048	0.002	0.038	26.211
Motive strength x Inhibitory Control	0.009	-0.015	0.034	3.548	0.282
Motive strength	0.123	0.030	0.224	399.000	0.003
Motive strength x Cognitive Reflection	-0.022	-0.102	0.039	0.315	3.175
Motive strength x Inhibitory Control	-0.017	-0.079	0.062	0.429	2.331
Motive strength	0.126	0.072	0.190	Inf	0.000
Motive strength x Cognitive Reflection	-0.019	-0.074	0.038	0.321	3.119
Motive strength x Inhibitory Control	0.063	0.010	0.122	95.386	95.386

Supplementary Figure 2

Extract draws

m2.pol.draws <- m2.pol %>% 
  epred_draws(newdata = expand_grid(issue_motive_strength = c("Anti-strong",
                                                         "Anti-moderate",
                                                         "Neutral", 
                                                         "Pro-moderate",
                                                         "Pro-strong"),
                                    question_topic = levels(data_pol$question_topic)),
              re_formula = ~(issue_motive|question_topic)) 

m2.per.draws <- m2.per %>% 
  epred_draws(newdata = expand_grid(issue_motive_strength = c("Anti-strong",
                                                         "Anti-moderate",
                                                         "Neutral", 
                                                         "Pro-moderate",
                                                         "Pro-strong"),
                               question_topic = levels(data_per$question_topic)),
              re_formula = NA) 


m2.neu.draws <- m2.neu %>% 
  epred_draws(newdata = expand_grid(issue_motive_strength = c("Anti-strong",
                                                         "Anti-moderate",
                                                         "Neutral", 
                                                         "Pro-moderate",
                                                         "Pro-strong"),
                               question_topic = levels(data_neu$question_topic)),
              re_formula = NA) 

m2.draws <- bind_rows(m2.pol.draws, m2.per.draws, m2.neu.draws) %>% 
  mutate(issue_motive_strength = factor(issue_motive_strength,
                                        levels = c("Anti-strong",
                                                   "Anti-moderate",
                                                   "Neutral", 
                                                   "Pro-moderate",
                                                   "Pro-strong"),
                                        ordered = TRUE),
         question_topic = factor(question_topic, 
                        levels = c("climate",
                                   "immigration",
                                   "gender",
                                   "discrimination",
                                   "adoption",
                                   "punishment",
                                   "gonogo_performance",
                                   "fakenews_performance",
                                   "teaculture",
                                   "brain"),
                        labels = c("Anthropogenic climate change",
                                   "Immigrant population",
                                   "Gender stereotypes",
                                   "Racial discrimination",
                                   "Same-sex adoption",
                                   "Criminal reconviction",
                                   "Go / No-Go performance",
                                   "Fake News performance",
                                   "Tea with milk",
                                   "Brain proportion")))

Create figure

m2.draws %>% 
  mutate(perc = .epred * 100) %>% 
  ggplot(aes(x = perc, y = issue_motive_strength, fill = issue_motive_strength)) +
  stat_halfeye(slab_alpha = 0.9, .width = c(0.5, 0.95), 
               point_interval = "median_qi") +
  geom_vline(xintercept = 50, alpha = 0.8, linewidth = 0.8, 
             color = "black", linetype = "dashed") +
  guides(fill = "none") +
  scale_fill_manual(values = rev(beyonce_palette(41, n = 5, 
                                             type = "continuous"))) +
  labs(title="Message Ratings by Motive Strength",
       x = "Coefficients", y = NULL,
       caption = "50% and 95% credible intervals shown in black") +
  scale_x_continuous(labels = label_percent(scale = 1), limits = c(25, 75),
                     breaks = seq(30, 70, by = 10)) +
  theme_ipsum_rc(base_size = 12,
                 plot_title_size = 14,
                 axis_title_size = 12,
                 axis_title_face = "bold",
                 axis_text_size = 12,
                 strip_text_size = 12,
                 strip_text_face = "bold"
                 ) + 
  facet_wrap(~question_topic, ncol = 2)

ggsave(here(fig_dir, "m2_perc_fig.png"), width = 8, height = 12, dpi = 300)